perm filename MOVIT.F4[P11,LCS]2 blob
sn#573354 filedate 1981-03-16 generic text, type T, neo UTF8
00100 C****** SUBRS MOVIT, OUTLMT, GETPTS, GUPDAT, DELETE, STFCH,COPYIT,CPYIT
00150 C--- FROM MOVE.FAI=GETPTS,MOVIT,COPYIT,STFCH,DELETE
00200 SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
00300 DIMENSION NP(1),RN(1)
00400 COMMON /KJY/ NO,J
00500 RDIS=(R9-R8)/(R5-R4)
00600 DO 1 K=1,J
00700 L=NP(K)
00800 RA=RN(L)
00900 IF(OUTLMT(R4,R5,RA))GO TO 1
01000 IF(R9.NE.0)RA=(RA-R4)*RDIS
01100 RN(L)=R8+RA
01200 1 CONTINUE
01300 END
01400
01500 FUNCTION OUTLMT(A,B,R)
01600 C TELLS IF POINT IS WITHIN BOUNDS OF A-B (PUT THIS INTO MACRO)
01700 OUTLMT=-1.
01800 IF(R.LT.A)RETURN
01900 IF(R.GT.B)RETURN
02000 OUTLMT=0
02100 END
02200
02300 SUBROUTINE GETPTS(NN)
02400 C NN IS FIRST ITEM TO LOOK AT
02500 INTEGER PWDS
02600 COMMON/XRN/RN(1) /KJY/ K,J /POSI/STFF(8),JJ2
02700 COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
02800 1/PTR/PWDS(1) /RINP/R(500),N(350),NP(250) /LIMIT/LIM,ITEM
02900 EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R6,RJQ(4))
03000 J=0
03100 K=0
03200 C J AND K ARE COUNTERS FOR N AND NP ARRAYS.
03300 DO 1 M=NN,ITEM
03400 L=PWDS(M)
03500 RY=RN(L+1)
03600 IF(R2.GE.8)GO TO 3
03700 C >=8 MEANS LOOK AT ALL STAVES
03800 IF(R2.NE.RN(L+2))GO TO 1
03900 C SKIP IF NOT RIGHT STAFF NUM.
04000 3 IF(R6.LE.0)GO TO 9
04100 C CHECK CODE NUM
04200 IF(R6.NE.RY)GO TO 1
04300 9 IF(OUTLMT(R4,R5,RN(L+3)))GO TO 2
04400 C IN LIMITS?
04500 CALL GUPDAT(M,L,3)
04600 C GO PUT AWAY POINTER TO P3 OF THIS ITEM
04700 K=K+1
04800 NP(K)=L
04900 C NP SAVES POINTER TO P3 FOR USE IN JUSTIFY ROUTINE
05000 2 CNT=RN(L)
05100 C GET THE WD CNT
05200 IF(RY.EQ.2)GO TO 8
05300 C FOR 'CENTERED' RESTS
05400 IF(RY.LT.4)GO TO 1
05500 IF(RY.GT.7)GO TO 1
05600 IF(RY.EQ.6)GO TO 6
05700 C TWO-ENDED ITEM?
05800 7 IF(CNT.GT.3)GO TO 5
05900 GO TO 1
06000 6 IF(CNT.LT.8)GO TO 8
06100 IF(RN(L+7).LT.0)GO TO 8
06200 IF(RN(L+10).EQ.0)GO TO 8
06300 IF(RN(L+8).LE.0)GO TO 8
06400 C IGNORE P8 IF IT IS 0 OR -
06500 IF(OUTLMT(R4,R5,RN(L+8)))GO TO 8
06600 C IN LIMITS?
06700 CALL GUPDAT(M,L,8)
06800 C PUT AWAY POINTER TO P8 FOR THIS BEAM
06900 8 IF(CNT.LT.7)GO TO 5
07000 IF(RN(L+9).LE.0)GO TO 5
07100 C WON'T LOOK AT NEG. POS.
07200 IF(RY.EQ.2)GO TO 10
07300 C (NEW REST CENTERING)
07400 IF(RN(L+8).NE.0)GO TO 10
07500 IF(RN(L+7).GE.0)GO TO 5
07600 C USE R9 IF R9<0 AND (R8≠0 OR R7<0)
07700 10 IF(OUTLMT(R4,R5,RN(L+9)))GO TO 1
07800 C IN LIMITS?
07900 CALL GUPDAT(M,L,9)
08000 5 IF(RY.EQ.2)GO TO 1
08100 IF(OUTLMT(R4,R5,RN(L+6)))GO TO 1
08200 C IN LIMITS?
08300 CALL GUPDAT(M,L,6)
08400 C PUT AWAY POINTER TO P6 FOR ALL 2-SIDED ITEMS.
08500 1 CONTINUE
08600 END
08700
08800 SUBROUTINE GUPDAT(M,L,KK)
08900 COMMON /KJY/ K,J /POSI/STFF(8),JJ2 /RINP/R(500),N(350),NP(250)
09000 J=J+1
09100 N(J)=L+KK
09200 C SETS UP POINTERS FOR USE IN MOVES, ETC.
09300 IF(M.LT.JJ2)JJ2=M
09400 END
09500
09600 SUBROUTINE DELETE
09700 IMPLICIT INTEGER(A-Q,S-Z)
09800 COMMON/DL/X22,SAVER,NAME /XRN/RN(1)
09900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(15),R6,DEL,X,JY,K
10000 COMMON/PTR/PWDS(1) /LIMIT/LIM,ITEM,L,I,IX
10100 1 /DPY/ST(4000),MEDIT,IGO /DPTR/WDS(350)
10200 EQUIVALENCE (ST2,ST(2))
10300 IX=I
10400 L=RN(MEDIT)+3
10500 C SIZE OF DELETION
10600 I=IX-L
10700 CALL LOOP(MEDIT,I,1,0,L,RN)
10800 JY=WDS(X22+1)-WDS(X22)
10900 CALL LOOP(WDS(X22)+2,WDS(ITEM),1,0,JY,ST)
11000 K=X22
11100 194 N=K+1
11200 WDS(N)=WDS(N+1)-JY
11300 PWDS(K)=PWDS(N)-L
11400 K=N
11500 IF(K.LT.ITEM)GO TO 194
11600 C ABOVE RESHUFFLES POINTER ARRAYS. X=ITEM+1
11700 ITEM=ITEM-1
11800 IF(X22.GT.ITEM)X22=ITEM
11900 J2=ITEM
12000 ITEM=ITEM-1
12100 ST2=WDS(J2)
12200 271 CALL DPYNEW
12300 END
12400
12500 SUBROUTINE STFCH
12600 CALL CPYIT(1)
12700 END
12800 SUBROUTINE COPYIT
12900 CALL CPYIT(0)
13000 END
13100
13200 SUBROUTINE CPYIT(KC)
13300 INTEGER PWDS
13400 COMMON/XRN/RN(1) /POSI/S(8),JJ2,P
13500 COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
13600 1/PTR/PWDS(1) /LIMIT/LIM,ITEM,LL,I,IX
13700 EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
13800 1,(R6,RJQ(4))
13900
14000 C KC IS FLAG FOR STFCH ROUTINE
14100 IM=ITEM
14200 DO 1 K=1,IM
14300 L=PWDS(K)
14400 IF(RTLINE(L))GO TO 1
14500 IF(OUTLMT(R4,R5,RN(L+3)))GO TO 1
14600 IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
14700 IF(KC.NE.0)GO TO 2
14800 M=RN(L)+2
14900 CALL LOOP(0,M,1,I,L,RN)
15000 ITEM=ITEM+1
15100 L=PWDS(ITEM)
15200 2 IF(R7.LE.7.)RN(L+2)=R7
15300 IF(KC.EQ.0)GO TO 3
15400 IF(K.LT.JJ2)JJ2=K
15500 GO TO 1
15600 3 IF(ITEM.LT.JJ2)JJ2=ITEM
15700 I=I+M+1
15800 PWDS(ITEM+1)=I
15900 1 CONTINUE
16000 IF(KC.EQ.0)R2=R7
16100 END